perm filename SVR.SAI[DLN,MRC] blob
sn#444727 filedate 1979-05-22 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00017 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00003 00002 BEGIN "Server FTP" comment Server Dialnet File Transfer program
C00004 00003 Macro definitions and global variable declarations
C00013 00004 DoCLS, DoINT, GET6BIT and GETASCII for interrupts and conversions
C00016 00005 SENDREPLY BRINGCOMMAND send and receive replies and commands
C00019 00006 GETCOMMAND, BUSY and ABORT.
C00022 00007 DSKtoDLN
C00025 00008 DLNtoDSK
C00036 00009 USER, PASSWORD, ACCOUNT and CHANGE_DIRECTORY
C00042 00010 DATA takes transmission parameters, NEWNAME renames a file
C00052 00011 DIRECTORY returns the contents of a .UFD file in list format
C00056 00012 SERVER and STATUS return info about server and state of connection
C00060 00013 RETRIEVE gets a file from the disk and sends it on Dialnet
C00063 00014 STORE gets a file and puts it in the disk
C00067 00015 DOCOMMAND executes one command
C00070 00016 Main server program. Initializations.
C00074 00017 RUN!!
C00076 ENDMK
C⊗;
BEGIN "Server FTP" comment Server Dialnet File Transfer program
Upon being awakened by a RPC packet, the server sends another RPC
to confirm the connection. It will then send a greeting message.
From then on, the program goes into a get command-do command loop.
When getting a command, it will wait until a whole command has been
received (bringcommand reads from Dialnet on channel 1). The docommand
dispatcher will call the appropiate procedure to handle the command.
;
Comment Macro definitions and global variable declarations
;
REQUIRE "{}{}" DELIMITERS;
DEFINE ! = { comment };
DEFINE # = { ;comment };
DEFINE newline = {('15&'12)};
DEFINE tab = {('11&null)};
DEFINE THRU = { STEP 1 UNTIL };
DEFINE UPTO = { ←1 STEP 1 UNTIL };
DEFINE BEGINLOOP={ WHILE TRUE DO BEGIN };
DEFINE ALPHA = {"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"};
DEFINE NUMER = {"0123456789"};
! Indexes for interrupts;
DEFINE INTINS_INX = {12} # abort transmission;
DEFINE INTIMS_INX = {13} # close connection;
DEFINE loc = {location};
DEFINE ascii = {1}, image = {2} # types of data;
DEFINE Del = {TRUE}, NoDel = {FALSE};
DEFINE Apnd = {TRUE}, NoApnd = {FALSE};
DEFINE NoWait = {'40000000}, Waitt = {0};
DEFINE receiving= {1}, sending= {2} # modes of TransferActive;
! Masks for word fields;
DEFINE rh(t) = {((t) land '000000777777)} # right half of word;
DEFINE lh(t) = {((t) land '777777000000)} # left half of word;
DEFINE pos(t) = { ((t) lsh -30) } # position field in a byte pointer;
DEFINE ACfield = {'40000000} # 1 in accumulator field in an instruction;
DEFINE errorcode= { rh(DSKflag) } # select error codes for LOOKUP and ENTER;
INTEGER DLNIOWORD # IOWORD for Dialnet;
DEFINE DLNEOF = {DLNIOWORD LAND '400} # end of file for Dialnet device;
DEFINE CLEAR!DLNIOINT = {BEGIN DLNIOWORD←DLNIOWORD land (lnot '100);
CODE(DLNSETST,memory[rh(DLNIOWORD)]) END };
EXTERNAL INTEGER NOPOLL;
DEFINE CLEAR!DLNIOWORD = {BEGIN CODE(DLNSETST,memory['17]); DLNIOWORD←'17 END };
DEFINE JLOG = {(CALL(curjob,"JBTSTS") LAND '10000000000)} # already logged in?;
! Instruction codes for CODE statement;
INTEGER MTAPE,DSKMTA,DLNINPUT,DLNOUTPUT,DLNGETST,DLNSETST;
EXTERNAL INTEGER _SKIP_ # successful return from CODE?;
EXTERNAL INTEGER INIACS # initial contents of registers;
! Memory blocks for Dialnet MTAPES;
INTEGER RPCcode,RPChpid,RPClpid,RPCwin,RPCdn1,RPCdn2,RPCdn3,RPCdn4;
INTEGER CLScode;
INTEGER EOFcode,EOFchan;
INTEGER FBOcode;
! Block for DSK MTAPE to check passwords;
INTEGER COMgw,COMcode,COMinx,COMdat;
! For OPEN,LOOKUP and ENTER;
INTEGER DLNcount,DLNchan,DLNbreak,DLNclosed,DLNflag;
INTEGER DSKcount,DSKchan,DSKbreak,DSKeof,DSKflag;
DEFINE windowsize={8} # window size for Dialnet I/O;
! The program uses four buffers. `combuf' contains the commands received from the
user before they are processed. `repbuf' contains the replies before they are sent.
`databuf' holds data both coming in and going out. For each of these buffers there
is a pointer, byte count and channel that are used by Dialnet to perform the I/O.
It is useful to keep a pointer to the first byte of each buffer in a constant (two
for `databuf' because two byte sizes may be used). Additionaly, a buffer `imagbuf'
is used to hold image data the format of which changes to/from the disk from/to
Dialnet;
DEFINE comwords = {128}, combytes = {(comwords*5)} # size of `combuf';
DEFINE repwords = {128}, repbytes = {(repwords*5)} # size of `repbuf';
DEFINE dskwords={256} # number of words obtained from (sent to) the
disk in a single operation. `dskwords' MUST be even;
DEFINE asciibytes = {(dskwords*5)}, asciiwords = {dskwords},
imagbytes = {((dskwords*9+1) div 2)}, imagwords = {((imagbytes+3) div 4)},
databufsize = {(imagwords+2)} # size of `databuf';
SAFE INTEGER ARRAY combuf[0:comwords-1] # buffer for command strings;
DEFINE com0 = {POINT(7,combuf[0],-1)} # pointer to first byte in command buffer;
INTEGER comp,comcount,comchan # pointer,count and channel (used by DLNINPUT);
INTEGER comtosee # number of command bytes remaining in buffer;
SAFE INTEGER ARRAY repbuf[0:repwords-1] # buffer for reply strings;
DEFINE rep0 = {POINT(7,repbuf[0],-1)} # pointer to first byte in reply buffer;
INTEGER repp,repcount,repchan # pointer,count and channel (used by DLNOUTPUT);
SAFE INTEGER ARRAY databuf[0:databufsize-1] # buffer for Dialnet data;
DEFINE ascii0 = {POINT(7,databuf[0],-1)},
imag0 = {POINT(8,databuf[0],-1)} # first byte in data buffer;
INTEGER datap,datacount,datachan # pointer,count and channel (used by DLN INPUT/OUTPUT);
SAFE INTEGER ARRAY imagbuf[0:dskwords+1] # buffer for image data from disk;
! The following are global variables used to pass parameters among procedures;
INTEGER Logging,TransferActive,Closing,Interrupting,Aborted;
STRING command,args # components of a command;
STRING curcommand # last received command;
INTEGER datev,timev,nbytes,tbytes # for statistics;
INTEGER usrppn,alias # permanent and temporary user identification;
STRING accnt # account id ;
INTEGER bytesize,type # logical byte size and type for data transmission;
STRING bytsize,typ,structure # byte size, character code and data organization;
STRING device # port for connection;
INTEGER jobsts,curjob # is current job logged in? curjob is 0;
BOOLEAN phantom # says whether the job is already logged in;
SAFE INTEGER ARRAY InfoArray[1:6] # to get size of file for RETRIEVE;
INTEGER skipspaces,oneword,oneatom,fname,uptoquote # break tables;
INTEGER chr # break character for string scan;
Comment DoCLS, DoINT, GET6BIT and GETASCII for interrupts and conversions;
;
SIMPLE PROCEDURE DoCLS # When there is a CLOSE interrupt;
Closing ← TRUE;
SIMPLE PROCEDURE DoINT # When there is an ABORT interrupt;
BEGIN
IF TransferActive AND NOT Aborted THEN Interrupting ← TRUE;
CLEAR!DLNIOINT
END;
SIMPLE INTEGER PROCEDURE get6bit(STRING str);
! The first three characters of str are converted to sixbit and right-justified
in the left half of a word. If str has more than 3 characters,the rest up to
the sixth will appear left-justified in the right half of the word;
BEGIN "To sixbit" INTEGER l;
l ← LENGTH(str);
RETURN(IF l≥3 THEN CVSIX(STR) ELSE (CVSIX(str) LSH (6*(l-3))));
END "To sixbit";
SIMPLE STRING PROCEDURE getASCII(INTEGER dev);
! The SIXBIT code contents of `dev' is converted to an ASCII string;
BEGIN "To ASCII" INTEGER i;STRING ds;
FOR i upto 6 DO
BEGIN ds ← (('77 LAND dev)+'40) & ds; dev ← dev LSH (-6) END;
RETURN(ds);
END;
DEFINE makedir(n,d)= ! Convert the SIXBIT directory name n into a string d;
{ BEGIN d←CVXSTR(n); d ← "[" & d[1 to 3] & "," & d[4 to 6] & "]" END
};
SIMPLE STRING PROCEDURE get_fname;
! Gets the name of a file from the head of args and deletes it there;
BEGIN "Get file name" STRING fn,dn;
SCAN(args,skipspaces,chr);
IF chr="↓" THEN BEGIN ! Garbled file name;
fn←LOP(args)&SCAN(args,uptoquote,chr);
chr←LOP(args);
IF chr="." THEN BEGIN fn←fn&chr&LOP(args)&SCAN(args,uptoquote,chr);
chr ← LOP(args) END
END
ELSE fn ← SCAN(args,fname,chr);
IF chr="[" THEN ! File name includes directory;
dn ← "[" & SCAN(args,oneatom,chr) & "," & SCAN(args,oneatom,chr) & "]"
ELSE ! Append current working directory;
makedir(alias,dn);
RETURN( fn&dn )
END "Get file name";
Comment SENDREPLY BRINGCOMMAND send and receive replies and commands
;
SIMPLE PROCEDURE SendReply(STRING Reply);
! Puts the string argument in the control buffer and sends it out on channel 2.
Reply should never be too long (i.e.,must be length(Reply)<repwords*5 ) but the
procedures that call SendReply take care of that. The reason is that we want to
send the reply as soon as the command is given, not having to wait until the
buffer is full;
BEGIN "Send String"
repcount ← LENGTH(Reply);
repp ← rep0;
WHILE (chr←LOP(Reply)) DO IDPB(chr,repp);
repp ← rep0;
IF Closing THEN RETURN;
CODE(DLNOUTPUT,repp); CODE(MTAPE,FBOcode)
END "Send String";
SIMPLE PROCEDURE bringCommand;
! Fill in block and issue DLNINPUT UUO to read one byte forcibly. If next packet
is end of file or comes on a channel other than 1, discard it and try again,
otherwise proceed copying into the command buffer;
BEGIN "bringCommand"
BEGINLOOP
comp←com0; comcount←1; comchan←1;
CODE(DLNINPUT,comp);CODE(DLNGETST,DLNIOWORD);
IF Closing THEN RETURN;
comp ← comp+NoWait; comcount ← combytes+comcount-1;
IF comchan=1 THEN DONE # got something;
IF DLNEOF THEN CONTINUE;
CODE(DLNINPUT,comp) # skip data packets;
IF Closing THEN RETURN END;
CODE(DLNINPUT,comp);CODE(DLNGETST,DLNIOWORD);
comp←com0; comtosee← combytes-comcount;
END "bringCommand";
Comment GETCOMMAND, BUSY and ABORT.
;
SIMPLE PROCEDURE getCommand;
! Gets a command from Dialnet and scans for command word and arguments;
BEGIN "Get Command" INTEGER nestcnt;
command ← "" # erase old command;
IF Closing THEN RETURN;
! Look for left parenthesis;
DO BEGIN
IF comtosee=0 THEN BEGIN bringCommand; IF Closing THEN RETURN END;
chr←ILDB(comp); comtosee←comtosee-1 END
UNTIL chr="(";
! Skip spaces;
DO BEGIN
IF comtosee=0 THEN BEGIN bringCommand;IF Closing THEN RETURN END;
chr←ILDB(comp); comtosee←comtosee-1 END
UNTIL chr≠" ";
WHILE (chr≠" ") and (chr≠")") DO BEGIN
command ← command&chr;
IF comtosee=0 THEN BEGIN bringCommand;IF Closing THEN RETURN END;
chr←ILDB(comp); comtosee←comtosee-1 END;
nestcnt ← IF chr=")" THEN 0 ELSE 1;
args ← "";
WHILE nestcnt>0 DO BEGIN
args ← args&chr;
IF comtosee=0 THEN BEGIN bringCommand;IF Closing THEN RETURN END;
chr←ILDB(comp); comtosee←comtosee-1;
IF chr=")" THEN nestcnt←nestcnt-1 ELSE IF chr="(" THEN nestcnt←nestcnt+1 END;
comchan←2; comp←comp lor NoWait; comcount←1 # RETRIEVE must find the parameters set;
END "Get Command";
SIMPLE BOOLEAN PROCEDURE busy;
BEGIN "Busy"
! Sends a message to the user if the data channel is busy;
Aborted ← FALSE # the new command is not aborted yet;
IF TransferActive THEN BEGIN
sendReply("(BUSY (DATA TRANSFER IN PROGRESS: CAN'T ATTEND "&command&" COMMAND))");
RETURN(TRUE) END
ELSE BEGIN curcommand ← command & " " & args;RETURN(FALSE) END;
END "Busy";
SIMPLE PROCEDURE abort;
! Sets `Aborted'if there was a data transfer. Otherwise sends appropiate reply;
IF TransferActive THEN BEGIN
Interrupting ← TRUE # in case the INT arrived too late;
Aborted←TRUE;
END
ELSE sendReply("(OK (NO TRANSFER IN PROGRESS))");
Comment DSKtoDLN
;
SIMPLE PROCEDURE DSKtoDLN;
! Reads into the data buffer(if eof is not reached first) from the file open on
the channel DSKchan and outputs its data contents to DLN (in channel
DLNchan) on the FTP channel 0 .;
BEGIN "ODM" INTEGER i,w,ww;
IF type=ascii THEN BEGIN ! Take data directly into Dialnet buffer;
ARRYIN(DSKchan,databuf[0],dskwords);
datap ← ascii0; # clear buffer;
datacount ← IF DSKeof THEN rh(DSKeof)*5 ELSE asciibytes;
nbytes ← nbytes+datacount END
ELSE BEGIN ! Must reformat data;
ARRYIN(DSKchan,imagbuf[0],dskwords);
datap ← imag0 # clear buffer;
datacount ← IF DSKeof THEN rh(DSKeof) ELSE dskwords;
nbytes ← nbytes+datacount # update number of bytes obtained from disk;
FOR i←0 THRU datacount-1 DO BEGIN ! convert two words at a time;
w←imagbuf[i];
IDPB(w,datap); w ← w lsh -8;
IDPB(w,datap); w ← w lsh -8;
IDPB(w,datap); w ← w lsh -8;
IDPB(w,datap); w ← w lsh -8;
i←i+1; ww←w; w←imagbuf[i];
IDPB(ww lor w lsh 4,datap); w ← w lsh -4;
IDPB(w,datap); w ← w lsh -8;
IDPB(w,datap); w ← w lsh -8;
IDPB(w,datap); w ← w lsh -8;
IDPB(w,datap);
END;
datap←imag0;
datacount ← (datacount*9+1) div 2 # converting logical bytes into Dialnet bytes;
END;
IF Closing THEN RETURN;
CODE(DLNOUTPUT,datap);
END "ODM";
Comment DLNtoDSK
;
SIMPLE PROCEDURE DLNtoDSK;
! Reads from DLN (channel DLNchan) on FTP channel 1 and writes on the file open
for input on channel DSKchan.
Start by filling in block and issuing DLNINPUT UUO to read one byte forcibly.
If next packet is end_of_file or comes on a channel other than 0 then return
otherwise proceed copying data into the buffer.;
BEGIN "IDM" INTEGER temp_count,temp_p; INTEGER i,w;
temp_count ← datacount; temp_p←datap;
datacount ← 1;
CODE(DLNINPUT,datap);CODE(DLNGETST,DLNIOWORD);
datacount ← IF datap=temp_p THEN temp_count ELSE temp_count-1 # datacount is not accurate;
IF (datachan≠0) THEN RETURN # there is a command in the input stream;
IF (datacount≠0) and not DLNEOF THEN BEGIN "Read more"
datap ← datap lor NoWait;
CODE(DLNINPUT,datap);CODE(DLNGETST,DLNIOWORD);
datap ← datap land (lnot NoWait) END "Read more";
IF datacount=0 THEN ! Buffer is full. Pass contents to disk;
IF type=ascii THEN BEGIN ! Pass data as is;
ARRYOUT(DSKchan,databuf[0],asciiwords);
nbytes ← nbytes+asciibytes;
datap ← ascii0; datacount ← asciibytes; RETURN END
ELSE BEGIN ! Convert image data;
datap ← imag0;
FOR i←0 STEP 2 UNTIL dskwords DO BEGIN
imagbuf[i]←(((ILDB(datap) rot -8 lor ILDB(datap)) rot -8
lor ILDB(datap)) rot -8 lor ILDB(datap)) rot -12
lor lh(w←ILDB(datap) rot -4);
imagbuf[i+1]←((((rh(w) rot -4 lor ILDB(datap)) rot -8
lor ILDB(datap)) rot -8 lor ILDB(datap)) rot -8
lor ILDB(datap)) rot -8 END;
ARRYOUT(DSKchan,imagbuf[0],dskwords);
nbytes ← nbytes+dskwords # logical bytes;
datap ← imag0; datacount ← imagbytes; RETURN END;
IF DLNEOF THEN ! When eof, bytes still in the buffer must be sent to the disk;
IF type=ascii THEN BEGIN ! Complete word and pass data as is;
IF pos(datap)≥36 THEN RETURN ELSE WHILE pos(datap)>1 DO IDPB(0,datap);
ARRYOUT(DSKchan,databuf[0],rh(datap)-rh(ascii0)+1);
nbytes ← nbytes+asciibytes-datacount;
datap ← ascii0; datacount ← asciibytes END
ELSE BEGIN ! Convert image data;
temp_p←datap; datap ← imag0;
FOR i←0 STEP 2 UNTIL dskwords DO BEGIN
imagbuf[i]←(((ILDB(datap) rot -8 lor ILDB(datap)) rot -8
lor ILDB(datap)) rot -8 lor ILDB(datap)) rot -12
lor lh(w←ILDB(datap) rot -4);
imagbuf[i+1]←((((rh(w) rot -4 lor ILDB(datap)) rot -8
lor ILDB(datap)) rot -8 lor ILDB(datap)) rot -8
lor ILDB(datap)) rot -8;
IF rh(datap)>rh(temp_p) THEN DONE END;
i ← ((imagbytes-datacount)*2+7) div 9 # numer of logical bytes;
ARRYOUT(DSKchan,imagbuf[0],i);
nbytes ← nbytes+i # logical bytes;
datap ← imag0; datacount ← imagbytes; END
END "IDM";
Comment USER, PASSWORD, ACCOUNT and CHANGE_DIRECTORY ;
! change_directory will change only the dskppn but `user' will change both
it and the log-in id;
SIMPLE PROCEDURE user;
BEGIN "User"
! Handles the USER command. Saves the argument,(checks it) and returns the
appropiate reply.
At SUAI the argument should be a ppn, with the fixed format:
[project,programmer] or [project,programmer
or project,programmer or programmer (then project 1 will be assumed)
where project and programmer must be alphanumeric strings.;
INTEGER project,programmer;
SCAN(args,skipspaces,chr);
IF chr="[" THEN chr←LOP(args) # skip "[";
project ← get6bit(SCAN(args,oneatom,chr));
IF chr="," THEN programmer ← get6bit(SCAN(args,oneatom,chr)) ROT 18
ELSE BEGIN programmer ← project ROT 18; project ← get6bit("1") END;
alias ← project LOR programmer;
LOOKUP(DSKchan,CVXSTR(alias) & ".UFD[1,1]",DSKflag);
IF DSKflag THEN sendReply("(FAILED (SORRY, I DO NOT KNOW YOU))")
ELSE BEGIN sendReply("(OK (TELL ME YOUR SECRET))"); Logging ← TRUE END;
END "User";
SIMPLE PROCEDURE password;
! Handles the PASSWORD command. Saves the argument,(checks it) and returns the
appropiate reply.
At SUAI the argument should not contain space nor ←,→,[,],(, or ). It can
only consist of sixbit characters.;
BEGIN "Password" STRING passw;
CLOSE(DSKchan) # do not reopen directory;
LOOKUP(DSKchan,CVXSTR(alias) & ".UFD[1,1]",DSKflag) # file must be open to check password;
IF NOT Logging THEN sendReply("(FAILED (COMMAND OUT OF SEQUENCE))")
ELSE BEGIN
SCAN(args,skipspaces,chr);
passw ← SCAN(args,oneatom,chr) # get password from input;
COMdat ← CVSIX(passw) LSH ! put it in required format;
(IF LENGTH(passw)≥6 THEN 0 ELSE 6*(LENGTH(passw)-6));
CODE(DSKMTA,COMgw) # check with system;
IF _SKIP_ THEN BEGIN ! Correct;
IF phantom THEN BEGIN
usrppn ← ((-1) lsh 18) + loc(alias);
CALL(usrppn,"LOGIN") END;
CALL(alias,"DSKPPN") ;
Logging ← FALSE;
curcommand ← Command # do not show password with `status';
usrppn ← alias;
sendReply("(DONE (YOU ARE IN))") END
ELSE sendReply("(FAILED (YOU LOSE))") END;
CLOSE(DSKchan);
END "Password";
SIMPLE PROCEDURE account;
BEGIN "Account"
! Handles the ACCOUNT command and saves the argument. Because there are no accounts
at SUAI, this command is always a loser;
SCAN(args,skipspaces,chr);
accnt ← SCAN(args,oneword,chr);
sendReply("(FAILED (YOU ARE WASTING YOUR TIME))");
END "Account";
SIMPLE PROCEDURE change_directory;
! Sets the disk ppn. At SUAI the argument can have the format:
[project,programmer] or [project,programmer
or project,programmer or project (then current programmer is assumed)
where project and programmer must be alphanumeric strings.;
BEGIN "Alias" INTEGER project,programmer; STRING as;
SCAN(args,skipspaces,chr);
IF chr THEN BEGIN
IF chr="[" THEN chr←LOP(args) # skip "[";
project ← get6bit(SCAN(args,oneatom,chr));
programmer ← IF chr="," THEN get6bit(SCAN(args,oneatom,chr)) rot 18
ELSE rh(usrppn);
alias ← project lor programmer END
ELSE alias ← usrppn;
LOOKUP(DSKchan,CVXSTR(alias)&".UFD[1,1]",DSKflag);
makedir(alias,as) # convert the word of SIXBIT characters into a dir name;
IF DSKflag THEN sendReply("(FAILED (SORRY, NO SUCH DIRECTORY: "&as&"))")
ELSE BEGIN sendReply("(OK (YOUR WORKING DIRECTORY IS "&as&"))");
CALL(alias,"DSKPPN") END;
CLOSE(DSKchan);
END "Alias";
Comment DATA takes transmission parameters, NEWNAME renames a file;
SIMPLE PROCEDURE data;
! Handles the DATA command. Saves the arguments,(checks them) and returns the
appropiate reply.;
BEGIN "Data parameters" STRING byts,tps,stru;
SCAN(args,skipspaces,chr);
byts ←SCAN(args,oneatom,chr);
SCAN(args,skipspaces,chr);
tps ← SCAN(args,oneatom,chr);
FOR chr UPTO LENGTH(tps) DO
tps← tps[2 to ∞]&(IF tps≥"a" THEN (tps-'40) ELSE tps[1 for 1]);
SCAN(args,skipspaces,chr);
stru ← SCAN(args,oneatom,chr);
FOR chr UPTO LENGTH(stru) DO
stru← stru[2 to ∞]&(IF stru≥"a" THEN (stru-'40)
ELSE stru[1 for 1]);
IF (stru="FILE") and (byts="8") and (tps="ASCII") THEN type←ascii
ELSE IF (stru="FILE") and (byts="36") and (tps="IMAGE") THEN type←image
ELSE BEGIN sendReply("(FAILED (ONLY `8 ASCII FILE' AND `36 IMAGE FILE' IMPLEMENTED))");
RETURN END;
bytsize←byts; typ←tps; structure←stru;
sendReply("(OK (NEW DATA PARAMETERS: "&bytsize&" "&typ&" "&structure&"))");
END "Data parameters";
SIMPLE PROCEDURE newname(STRING fromname,toname);
! If toname is null the file fromname will be deleted, otherwise it will be given
the new name toname;
BEGIN "Rename"
LOOKUP(DSKchan,fromname,DSKflag);
IF DSKflag THEN BEGIN sendReply(CASE errorcode OF
("(FAILED (FILE " & fromname & " NOT FOUND))",
"(FAILED (PPN FOR FILE " & fromname & " HAS NO UFD))",
"(FAILED (" & fromname & "PROTECTION VIOLATION))",
"(BUSY (FILE " & fromname & "CURRENTLY OPEN IN READ-ALTER MODE))",
"",
"(BUSY (FILE " & fromname & "CURRENTLY OPEN FOR OUTPUT))",
"","",
"(FAILED (SERVER GUILTY OF FAILURE))",
"(FAILED (SERVER GUILTY OF FAILURE))",
""));
CLOSE(DSKchan); RETURN; END;
ERENAME(DSKchan,toname,0,0,0,0,DSKflag);
sendReply(IF DSKflag THEN CASE errorcode OF
("(FAILED (FILE " & fromname & " HAS BEEN DELETED))",
"(FAILED (PPN FOR FILE " & toname & " HAS NO UFD))",
"(FAILED (PROTECTION VIOLATION)",
"(BUSY (FILE " & fromname & "IS CURRENTLY BEING READ))",
"(FAILED (FILE " & toname & " ALREADY EXISTS)",
"(FAILED (SOMEONE ELSE IS MESSING WITH " & fromname & "))",
"", "",
"(FAILED (SERVER GUILTY OF FAILURE))",
"(FAILED (SERVER GUILTY OF FAILURE))",
"")
ELSE IF toname=null THEN "(OK (FILE " & fromname & " DELETED))"
ELSE "(OK (FILE "&fromname&" IS NOW "&toname&"))");
CLOSE(DSKchan);
END "Rename";
Comment DIRECTORY returns the contents of a .UFD file in list format;
SIMPLE PROCEDURE directory;
! Handles the DIRECTORY command.Returns a list of the files in the directory
which has been passed in the argument. As for the user command, the argument
must have the format
[project,programmer] or [project,programmer
or project,programmer or programmer (then project 1 will be assumed)
If no argument is passed in the command, the log-in directory will be returned.
;
BEGIN "Directory" INTEGER j;
INTEGER project,programmer,fsize,fnpart,dirname;
STRING flext,as;
STRING Reply;
SCAN(args,skipspaces,chr);
IF chr THEN BEGIN "directory name"
IF chr="[" THEN chr←LOP(args);
project ← get6bit(SCAN(args,oneatom,chr));
IF chr="," THEN programmer ← get6bit(SCAN(args,oneatom,chr)) ROT 18
ELSE BEGIN programmer ← project ROT 18; project ← get6bit("1") END;
dirname ← project LOR programmer END "directory name"
ELSE dirname ← alias;
as ← CVXSTR(dirname);
IF EQU(AS,"100100") THEN
BEGIN sendReply("(FAILED (YOU DID NOT SAY WHICH ONE))"); RETURN END;
LOOKUP(DSKchan, as & ".UFD[1,1]",DSKflag);
IF DSKflag THEN BEGIN
sendReply(CASE errorcode OF
("(FAILED (NO SUCH DIRECTORY:["&as[1 to 3]&","&as[4 to 6]&"]))",
"(FAILED (NO SUCH DIRECTORY:["&as[1 to 3]&","&as[4 to 6]&"]))",
"(FAILED (PROTECTION VIOLATION))",
"(BUSY (DIRECTORY IN USE))",
"",
"(BUSY (DIRECTORY IN USE))",
"", "",
"(FAILED (SERVER GUILTY OF FAILURE))",
"(FAILED (SERVER GUILTY OF FAILURE))",
""));
CLOSE(DSKchan,3); RETURN; END;
makedir(dirname,as);
Reply ← "(OK (("& "Filnam Ext Size" & newline & as & newline & ")";
BEGINLOOP ! Transmit one file name at a time;
fnpart ← WORDIN(DSKchan);
IF DSKeof THEN DONE # if all sent then exit;
IF fnpart THEN BEGIn # entry in use?;
Reply ← Reply & "(" & CVXSTR(fnpart);
fnpart ← lh(WORDIN(DSKchan));
Reply ← Reply & (IF fnpart THEN ("." & CVXSTR(fnpart)) ELSE tab);
WORDIN(DSKchan); WORDIN(DSKchan);
Reply ← Reply & tab & CVS(WORDIN(DSKchan)) & ")" ; END
ELSE BEGIN ! skip entry;
WORDIN(DSKchan); WORDIN(DSKchan);
WORDIN(DSKchan); WORDIN(DSKchan); END;
FOR j UPTO 11 DO WORDIN(DSKchan) # skip unused words of entry;
IF Closing THEN RETURN # don`t do output to closed channel;
IF LENGTH(Reply)>repbytes-14 THEN BEGIN Sendreply(Reply);Reply ← NULL END; END;
Reply ← Reply & ")"; SendReply(Reply);
CLOSE(DSKchan);
DSKeof ← 0;
END "Directory";
Comment SERVER and STATUS return info about server and state of connection;
SIMPLE PROCEDURE server;
! Handles the SERVER command. It returns the contents of the file
RPCSFT.DOC[net,sys] which contains information about naming conventions at
SUAI and which Dialnet commands are implemented there. Just as in DIRECTORY
the information is sent as a reply on channel 0, thus, it cannot be interrupted
and it should contain no parenthesis unless we want the user to look at it as
a list and treat it accordingly. By now this command will be accepted at any
time. Notice that the string is never more than contbytes long and, consequently,
things are right for sendreply;
BEGIN "Server Information" INTEGER serchan,sercnt,serbreak,sereof,serflag;
serchan←7 ; sercnt←repbytes;
OPEN(serchan,"DSK",0,19,0,sercnt,serbreak,sereof);
LOOKUP(serchan,"DLNSFT.IAZ[UP,DOC]",serflag);
IF serflag THEN sendReply("(FAILED (SORRY, NO INFO AVAILABLE))")
ELSE BEGIN sendReply("(OK (");
WHILE NOT sereof DO SendReply(INPUT(serchan,0));
sendReply("))") END;
RELEASE(serchan)
END "Server Information";
SIMPLE PROCEDURE status # handles the STATUS command;
BEGIN "Status" STRING us,as;
makedir(usrppn,us);
makedir(alias,as);
sendReply("(OK (" &
"USER: " & (IF usrppn AND (usrppn≠CVXSTR("100100")) THEN us ELSE "UNKNOWN") &
(IF usrppn≠alias THEN (" ALIAS: " & as ) ELSE null) & newline &
"CURRENT COMMAND: " & curcommand & newline &
"STATUS: "&(IF TransferActive THEN " IN PROGRESS. " ELSE "")&
(IF TransferActive=receiving THEN
CVS(nbytes)&" BYTES "&
(IF type=image THEN "[WORDS] ALREADY RECEIVED."
ELSE "ALREADY RECEIVED ["&CVS(nbytes/5)&" STORAGE WORDS]")
ELSE IF TransferActive=sending THEN
CVS(nbytes)&" BYTES "&
(IF type=image THEN "[WORDS] ALREADY TRANSFERRED OFF "&
CVS(tbytes)&" TOTAL."
ELSE "ALREADY RECEIVED OFF ≤"&CVS(tbytes)&" TOTAL."&newline&tab&
"["&CVS(nbytes/5)&" OFF "&CVS(tbytes/5)&" STORAGE WORDS]")
ELSE IF Aborted THEN "ABORTED"
ELSE IF curcommand THEN "COMPLETED"
ELSE null) & newline &
"DATA: "&bytsize&" "&typ&" "&structure& newline&"))");
END "Status";
FORWARD SIMPLE PROCEDURE DoCommand;
Comment RETRIEVE gets a file from the disk and sends it on Dialnet;
SIMPLE PROCEDURE retrieve(STRING fname);
! Obtains a file from the disk and sends it on Dialnet;
BEGIN "Retrieve" INTEGER rep;
LOOKUP(DSKchan,fname,DSKflag);
IF DSKflag THEN BEGIN sendReply(CASE errorcode OF
("(FAILED (FILE " & fname & " DOES NOT EXIST))",
"(FAILED (ILLEGAL PPN FOR " & fname & "))",
"(FAILED ("&fname&" PROTECTION VIOLATION))",
"(BUSY (FILE " & fname & "CURRENTLY OPEN IN READ-ALTER MODE))",
"",
"(BUSY (FILE " & fname & "CURRENTLY OPEN FOR OUTPUT))",
"",
"",
"(FAILED (SERVER GUILTY OF FAILURE))",
"(FAILED (SERVER GUILTY OF FAILURE))",
""));
CLOSE(DSKchan); RETURN; END;
sendReply("(OK (TRANSFER STARTED))");
TransferActive ← sending;
! Get size of file;
FILEINFO(InfoArray);
tbytes ← -(InfoArray[4] ROT 18) * (IF type=ascii THEN 5 ELSE 1);
nbytes ←0 # nothing read yet;
DO IF Interrupting THEN
BEGIN "Interrupt exit"
WHILE not Aborted DO BEGIN getCommand; doCommand END;
Interrupting ← FALSE;
sendReply("(STOPPED (TRANSFER ABORTED))");
DONE END "Interrupt exit"
ELSE IF DSKeof THEN
BEGIN "Normal exit"
CODE(MTAPE,EOFcode);
sendReply("(DONE (TRANSFER COMPLETED))");
DONE END "Normal exit"
ELSE BEGIN "Sending data"
DSKtoDLN;
IF Closing THEN DONE;
! See if there is a command. At this point comchan=2;
CODE(DLNINPUT,comp);CODE(DLNGETST,DLNIOWORD);
IF comtosee or (comchan=1) THEN BEGIN getCommand; doCommand END
END "Sending data"
UNTIL Closing;
RELEASE(DSKchan) # reset pointer in file;
OPEN(DSKchan,"DSK",'10,19,19,dskwords,DSKbreak,DSKeof);
TransferActive ← FALSE;
END "Retrieve";
Comment STORE gets a file and puts it in the disk;
SIMPLE PROCEDURE store(BOOLEAN append;STRING filen);
! Gets a file from Dialnet and stores (or appends) it in the disk;
BEGIN "Store" INTEGER rep,DSKc1,DSKb1,DSKe1,DSKf1;
ENTER(DSKchan,filen,DSKflag);
IF DSKflag THEN BEGIN sendReply(CASE errorcode OF
("(FAILED (ZERO FILE NAME GIVEN))",
"(FAILED (PPN FOR FILE " & filen & " HAS NO UFD))",
"(FAILED ("&filen&" PROTECTION VIOLATION))",
"(BUSY (FILE "&filen&" IS CURRENTLY BEING WRITTEN))","","",
"(BUSY (FILE " & filen & " IN USE))","",
"(FAILED (SERVER GUILTY OF FAILURE)",
"(FAILED (SERVER GUILTY OF FAILURE))",
"(FAILED (SERVER GUILTY OF FAILURE))"));
RELEASE(DSKchan,3);
OPEN(DSKchan,"DSK",'10,19,19,dskwords,DSKbreak,DSKeof);
RETURN; END;
IF append THEN BEGIN DSKc1 ←11;
OPEN(DSKc1,"DSK",'10,19,0,dskwords,DSKb1,DSKe1);
LOOKUP(DSKc1,filen,DSKf1) # error message was given above;
IF DSKf1 THEN BEGIN
sendReply("(FAILED (FILE "&filen&" DOES NOT EXIST))");
RELEASE(DSKchan,3) # do not create new file;
OPEN(DSKchan,"DSK",'10,19,19,dskwords,DSKbreak,DSKeof);
RELEASE(DSKc1); RETURN END
ELSE INOUT(DSKc1,DSKchan,-1);
RELEASE(DSKc1); END;
sendReply("(OK (TRANSFER STARTED))");
TransferActive ← receiving # state of connection;
! Clear buffer;
IF type=ascii THEN BEGIN datap←ascii0; datacount←asciibytes END
ELSE BEGIN datap←imag0; datacount←imagbytes END;
nbytes ← 0 # nothing received yet;
DO IF Interrupting THEN
BEGIN "Interrupt exit"
WHILE not Aborted DO BEGIN getCommand; doCommand END;
Interrupting ← FALSE;
sendReply("(STOPPED (TRANSFER ABORTED))");
CLEAR!DLNIOWORD # in case of end of file;
DONE END "Interrupt exit"
ELSE IF DLNEOF THEN
BEGIN "Normal exit"
IF Closing THEN DONE # do not modify file if sudden close;
TransferActive ← FALSE;
RELEASE(DSKchan) # save data and reset pointer in file;
OPEN(DSKchan,"DSK",'10,19,19,dskwords,DSKbreak,DSKeof);
CLEAR!DLNIOWORD;
sendReply("(DONE (TRANSFER COMPLETED))");
RETURN END "Normal exit"
ELSE BEGIN "Receiving data"
DLNtoDSK;
IF (datachan≠0) or (comtosee≠0) THEN
BEGIN datachan←0; getCommand; doCommand END;
END "Receiving data"
UNTIL Closing;
RELEASE(DSKchan,3) # discard received data;
OPEN(DSKchan,"DSK",'10,19,19,dskwords,DSKbreak,DSKeof);
TransferActive ← FALSE;
END "Store";
Comment DOCOMMAND executes one command;
SIMPLE PROCEDURE doCommand;
! Calls the appropiate routine to deal with the command (the command word was
stored in Command);
BEGIN "Do Command"
IF Closing THEN RETURN
ELSE IF EQU("STATUS",Command) THEN status
ELSE IF EQU("ABORT",Command) THEN abort
ELSE IF Busy THEN RETURN
ELSE IF EQU("USER",Command) THEN user
ELSE IF EQU("PASSWORD",Command) THEN password
ELSE IF EQU("ACCOUNT",Command) THEN account
ELSE IF EQU("CWD",Command) THEN change_directory
ELSE IF EQU("DATA",Command) THEN data
ELSE IF EQU("RENAME",Command) THEN BEGIN STRING fromname;
fromname←get_fname;
SCAN(args,skipspaces,chr)# skip spaces before `to';
chr←LOP(args)# read `t';
IF (chr≠"t") and (chr≠"T") THEN
BEGIN sendReply("(FAILED (NEED `TO' AFTER OLD NAME.expected t ,got "&chr&" ))");RETURN END;
chr←LOP(args)# read `o';
IF (chr≠"o") and (chr≠"O") THEN
BEGIN sendReply("(FAILED (NEED `TO' AFTER OLD NAME.expected o, got "&chr&" ))");RETURN END;
newname(fromname,get_fname) END
ELSE IF EQU("DELETE",Command) THEN newname(get_fname,null)
ELSE IF EQU("DIRECTORY",Command) THEN directory
ELSE IF EQU("SERVER",Command) THEN server
ELSE IF EQU("RETRIEVE",Command) THEN retrieve(get_fname)
ELSE IF EQU("STORE",Command) THEN store(NoApnd,get_fname)
ELSE IF EQU("APPEND",Command) THEN store(Apnd,get_fname)
ELSE sendReply("(FAILED (UNRECOGNIZED COMMAND))");
END "Do Command";
Comment Main server program. Initializations.
;
curjob ← 0;
phantom ← NOT JLOG # is current job logged-in ?;
IF phantom THEN device←getASCII(memory[loc(INIACS)+'17]) ! Take device from ac '17;
ELSE BEGIN device←"DLN2";PRINT(newline,"SYNCHRONIZE WITH <cr>:");INCHWL END;
DSKchan ← 5 # for disk I/O;
DLNchan ← 6 # for Dialnet I/O;
OPEN(DLNchan,device,'17,0,0,imagbytes,DLNbreak,DLNclosed);
IF NOT DLNclosed THEN
BEGIN "With Device"
! Instruction codes for CODE statement including mention of channel;
MTAPE ← '072000000000+ACfield*DLNchan;
DSKMTA ← '072000000000+ACfield*DSKchan;
DLNINPUT← '066000000000+ACfield*DLNchan;
DLNOUTPUT←'067000000000+ACfield*DLNchan;
DLNGETST← '062000000000+ACfield*DLNchan;
DLNSETST← '060000000000+ACfield*DLNchan;
! Code words for Dialnet MTAPE blocks;
RPCcode ← 0; CLScode ← 1; EOFcode ← 3; FBOcode ← 5;
! Block for UUO used to check passwords;
COMgw ← CVSIX("GODMOD"); COMcode ← '15; COMinx ← 0;
! Initialize buffer parameters;
datap ← ascii0; datacount ← asciibytes; datachan ← 0;
comp ← com0; comcount ← combytes; comtosee←0; comchan←1;
repp ← rep0; repcount ← repbytes; repchan ← 2;
EOFchan ← datachan # end_of_file packets go on the data channel;
! Initial conditions;
DLNIOWORD ← 0;
COMdat ← 0;
type←ascii;
bytsize←"8"; typ←"ASCII"; structure←"FILE";
curcommand ← command ← NULL;
Logging ← FALSE;
Closing ← FALSE;
TransferActive ← FALSE;
Interrupting ← FALSE;
Aborted ← FALSE;
! Allow ABORT and CLOSE interrupts;
INTMAP(INTIMS_INX,DoCLS,0);
INTMAP(INTINS_INX,DoINT,0);
ENABLE(INTIMS_INX);
ENABLE(INTINS_INX);
! Set break tables;
skipspaces ← GETBREAK;
SETBREAK(skipspaces," "," ","xnr");
oneword ← GETBREAK;
SETBREAK(oneword," ←→()","","ins");
oneatom ← GETBREAK;
SETBREAK(oneatom,ALPHA & NUMER,"","xns");
fname ← GETBREAK;
SETBREAK(fname," ,[","","ins");
uptoquote ← GETBREAK;
SETBREAK(uptoquote,"↓","","ina");
Comment RUN!!
;
! Fill in block and issue RPC UUO;
RPChpid ← 0; RPClpid ← 0 # with null process id;
RPCdn1 ← RPCdn2 ← RPCdn3 ← RPCdn4 ← 0 # and null TelCo number;
RPCwin ← windowsize # declare window size;
CODE(MTAPE,RPCcode);
IF _SKIP_ THEN BEGIN ! Connection is open;
OPEN(DSKchan,"DSK",'10,19,19,dskwords,DSKbreak,DSKeof);
IF DSKeof THEN BEGIN
sendReply("(FAILED (SUAI STANFORD UNIVERSISTY:: I CANNOT USE MY DISK))");
Closing←TRUE END
ELSE sendReply("(OK ( SUAI STANFORD UNIVERSITY ))");
! Log user in as [100,100];
alias ← usrppn ← CVSIX("100100"); CALL(usrppn,"DSKPPN");
! Main loop;
WHILE NOT Closing DO BEGIN getCommand; doCommand END;
RELEASE(DSKchan);
END;
RELEASE(DLNchan);
END "With Device";
END "Server FTP"